home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / pcfig4th.zip / UTIL.SCR < prev    next >
Text File  |  1985-04-23  |  9KB  |  1 lines

  1.                                                                                                                                                                                                                                                                                                                                                                                                              ||||||||||||||||||||||||||||||||                                ||| This space not dedicated |||                                ||||||||||||||||||||||||||||||||                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   ( utilities: memory dump: ?PR, etc. )                           FORTH DEFINITIONS DECIMAL                                       MYSEG VARIABLE SEGMENT  ( base segment for FETCH )                                                                              : NTIMES  BASE @ 4 MAX ; ( -- n   # locations to be displayed ) : FETCH   SEGMENT @ SWAP LC@ ; ( offset -- n )                  : ?NL     1+ NTIMES MOD 0= ; ( -- f  start new line ? )         : FWIDTH  ( -- n  field width for printing; depends on base )        BASE @  CASE  16 OF 3 ENDOF  10 OF 4 ENDOF  8 OF 4 ENDOF        2 OF 9 ENDOF  ( default case ) 16 BASE ! 3 SWAP ENDCASE ;  : ?PR     ( n -- f  tf if n is printable )                           127 AND DUP 127 < OVER 31 > AND ;                          : (D#)    DUP NTIMES + SWAP DO  ( addr --    dump numbers )               I ?NL IF LEAVE ENDIF                                            I FETCH FWIDTH .R LOOP ;                              -->                                                             ( utilities: memory dump: DUMP )                                                                                                : (DC)    DUP NTIMES + SWAP DO   ( addr --    dump chars )          I ?NL IF LEAVE ENDIF I FETCH ?PR IF EMIT                        ELSE DROP 46 EMIT ENDIF LOOP ;                                                                                              ( --   print SEGMENT if not FORTH )                             : SEG.    SEGMENT @ MYSEG = 0= IF SEGMENT @ 0 5 D.R                       THEN 58 EMIT ;                                                                                                        : DUMP    ( n -- n2 : display contents from n to n2-1 )                   8 0 DO CR    DUP DUP DUP                                           SEG. 0 5 D.R SPACE ( address )                                  (D#) SPACE SPACE   ( numbers ) (DC) ( chars )                   DUP NTIMES MOD NTIMES SWAP - + LOOP ;              ;S                                                              ( utilities: DEPTH S? VOC? BASE? )                              FORTH DEFINITIONS DECIMAL                                                   ( -- n  depth of stack )                            : DEPTH     SP@ S0 @ SWAP - 2 / 0 MAX ;                                     ( --   non-destructive stack display )              : S?        DEPTH IF SP@ S0 @ 2- DO I ? -2 +LOOP                            ELSE ." empty " ENDIF ;                             : VOC.      4 - NFA ID. ; ( addr --  print vocabulary id. )                 ( --   print CURRENT and CONTEXT ID )               : VOC?      CURRENT @ CONTEXT @ 2DUP = IF                                   ." CURRENT and CONTEXT are " VOC. DROP ELSE                     ." CONTEXT is " VOC. ." , CURRENT is " VOC. THEN                3 SPACES ;                                                      ( --   show current base in decimal )               : BASE?     BASE @ DUP DECIMAL . BASE ! ;                       ;S                                                              ( utilities: SIZE? NEW )                                        FORTH DEFINITIONS DECIMAL                                                ( --   show current length of FORTH dictionary                         and remaining free space )                      : SIZE?  HERE 0 +ORIGIN - 0 6 D.R ."  bytes used, "                      S0 @ HERE - 0 6 D.R ."  bytes free   " ;                        ( --   update start-up parameters to reflect FORTH's                   current state )                                 : NEW    CR ." current version is " 10 +ORIGIN C@ 65 + EMIT              CR ." new version (A-Z)? " KEY DUP EMIT 65 -                    10 +ORIGIN C!  ( user version )                                 [ ' FORTH 4 + ] LITERAL @ 12 +ORIGIN ! ( top of FORTH)          R0 @ 6 + 18 +ORIGIN 16 CMOVE ; ( user variables )      ;S                                                                                                                                                                                              ( utilities: BUFS? )                                            FORTH DEFINITIONS HEX                                           : .HEAD SPACE DUP 0< IF 2A EMIT ( * ) 7FFF AND                          ELSE BL EMIT ENDIF 5 .R ;                               : .TOP  CR CR ."  addr  block           contents" ;                     ( --   show state of block buffers )                    : BUFS? .TOP FIRST #BUFF 0 DO  CR                                       DUP 0 5 HEX D.R DECIMAL  ( buffer address )                     DUP @ .HEAD              ( block #, updated? )                  DUP USE  @ = IF ." <-USE " ELSE                                 DUP PREV @ = IF ." <-PREV" ELSE 6 SPACES THEN THEN              DUP 2+ 5 SPACES 28 TYPE  ( print buffer's contents )            B/BUF 4 + + LOOP  CR                                    ."       * = updated buffer       " ;                           DECIMAL ;S                                                                                                                      ( utilities: DLIST, WORDS )                                     FORTH DEFINITIONS HEX                                           : DLIST CR CR CR VLIST ; ( fig VLIST )                          : MORE? DUP IF @ 0A081 = 0= ENDIF ;                             DECIMAL     10 VARIABLE TABSTOP                                 : TAB   BEGIN OUT @ TABSTOP @ MOD WHILE SPACE REPEAT ;                                                                          : WORDS ( show context vocabulary, in columns )                      CR CR CR VOC?  80 OUT !                                         CONTEXT @ @                                                     BEGIN   OUT @ C/L >  IF CR 0 OUT ! THEN                            DUP  MORE? WHILE                                                DUP  ID. TAB                                                    PFA LFA @                                                    REPEAT  DROP ;                                             ;S                                                              ( Screen move utilities )                                       EDITOR DEFINITIONS DECIMAL                                      ( n --   copy screen n to the current screen )                  : GET SCR @ COPY ;                                                                                                              ( n m --   GET m screens, beginning at n )                      : GET# OVER + SWAP DO FORTH I EDITOR GET 1 SCR +! LOOP ;                                                                        234 CONSTANT SCR/DRIVE ( single density, 8" )                   ( n m --   copy screen n on drive 0 to screen m on drive 1 )    : DCOPY  DR0  SCR/DRIVE + COPY ;                                ( n --   copy screen n to the same screen on drive 1 )          : >DR1   DUP DCOPY ;                                            : #>DR1  OVER + 1+ SWAP DO ( n m --  copy n-m)                           FORTH I  EDITOR >DR1 LOOP ;                            FORTH DEFINITIONS ;S                                            ( screen copy utility )                                                                                                         : ASSIGN-BUF  ( n addr -- ;changes buffer-header at addr to n )      DUP SAVBUF SWAP 32768 + SWAP ! ; ( buffer is now updated! )                                                                : SCRCOPY   ( m n -- ;copies block m to n, but doesn't write n )            ( NOTE: if n is currently in a buffer this blows up)    SWAP BLOCK 2- ASSIGN-BUF ;                                                                                                  : #SCRCOPY  ( from to n -- ;copy n blocks )                          FLUSH                                                           ROT SWAP OVER + SWAP                                            DO                                                                 I OVER SCRCOPY 1+                                            LOOP DROP SAVE-BUFFERS ;